home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / message / subcls / ownrdraw.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-05-30  |  4.5 KB  |  136 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    Caption         =   "Owner-Draw Menu Demo"
  4.    ClientHeight    =   2880
  5.    ClientLeft      =   4020
  6.    ClientTop       =   3645
  7.    ClientWidth     =   4470
  8.    Height          =   3570
  9.    Left            =   3960
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   2880
  12.    ScaleWidth      =   4470
  13.    Top             =   3015
  14.    Width           =   4590
  15.    Begin MsgHook MsgHook 
  16.       Left            =   120
  17.       Top             =   120
  18.    End
  19.    Begin Menu mnuFile 
  20.       Caption         =   "&File"
  21.       Begin Menu mnuFileExit 
  22.          Caption         =   "E&xit"
  23.       End
  24.    End
  25.    Begin Menu mnuColor 
  26.       Caption         =   "&Color"
  27.       Begin Menu mnuColors 
  28.          Caption         =   "<black>"
  29.          Index           =   0
  30.       End
  31.       Begin Menu mnuColors 
  32.          Caption         =   "<blue>"
  33.          Index           =   1
  34.       End
  35.       Begin Menu mnuColors 
  36.          Caption         =   "<green>"
  37.          Index           =   2
  38.       End
  39.       Begin Menu mnuColors 
  40.          Caption         =   "<cyan>"
  41.          Index           =   3
  42.       End
  43.       Begin Menu mnuColors 
  44.          Caption         =   "<red>"
  45.          Index           =   4
  46.       End
  47.       Begin Menu mnuColors 
  48.          Caption         =   "<magenta>"
  49.          Index           =   5
  50.       End
  51.       Begin Menu mnuColors 
  52.          Caption         =   "<yellow>"
  53.          Index           =   6
  54.       End
  55.       Begin Menu mnuColors 
  56.          Caption         =   "<white>"
  57.          Index           =   7
  58.       End
  59.       Begin Menu mnuSep10 
  60.          Caption         =   "-"
  61.       End
  62.       Begin Menu mnuColorDefault 
  63.          Caption         =   "&Default"
  64.       End
  65.    End
  66. Option Explicit
  67. Sub Form_Load ()
  68.     Dim hMenu As Integer
  69.     Dim i As Integer, j As Integer
  70.     Dim nID As Integer
  71.     ' Get handle to "Colors" menu
  72.     hMenu = GetMenu(Me.hWnd)
  73.     hMenu = GetSubMenu(hMenu, 1)
  74.     ' Modify commands to be owner-draw and to contain color info
  75.     For i = 0 To 7
  76.         ' Get menu ID
  77.         j = GetMenuItemID(hMenu, i)
  78.         ' Modify menu item (command ID is maintained)
  79.         j = ModifyMenu(hMenu, j, MF_BYCOMMAND Or MF_OWNERDRAW, j, QBColor(8 + i))
  80.     Next i
  81.     ' Setup MsgHook
  82.     MsgHook.HwndHook = Me.hWnd
  83.     MsgHook.Message(WM_DRAWITEM) = True
  84.     MsgHook.Message(WM_MEASUREITEM) = True
  85. End Sub
  86. Sub mnuColorDefault_Click ()
  87.     ' Set background color
  88.     BackColor = GetSysColor(COLOR_WINDOW)
  89. End Sub
  90. Sub mnuColors_Click (Index As Integer)
  91.     ' Set background color
  92.     BackColor = QBColor(8 + Index)
  93. End Sub
  94. Sub mnuFileExit_Click ()
  95.     Unload Me
  96. End Sub
  97. Sub MsgHook_Message (msg As Integer, wParam As Integer, lParam As Long, result As Long)
  98.     Dim tmp As Integer, rc As RECT
  99.     Dim hBrush As Integer, hOldBrush As Integer
  100.     Dim DrawInfo As DRAWITEMSTRUCT
  101.     Dim MeasureInfo As MEASUREITEMSTRUCT
  102.     Select Case msg
  103.         Case WM_DRAWITEM
  104.             If wParam = 0 Then  'If sent by menu
  105.                 ' Copy DRAWINFOSTRUCT data to local variable
  106.                 Call hmemcpy(DrawInfo, ByVal lParam, Len(DrawInfo))
  107.                 ' Paint area around color bar
  108.                 If DrawInfo.itemState And ODS_SELECTED Then
  109.                     hBrush = CreateSolidBrush(GetSysColor(COLOR_HIGHLIGHT))
  110.                 Else
  111.                     hBrush = CreateSolidBrush(GetSysColor(COLOR_MENU))
  112.                 End If
  113.                 rc = DrawInfo.rcItem
  114.                 tmp = FillRect(DrawInfo.hDC, rc, hBrush)
  115.                 tmp = DeleteObject(hBrush)
  116.                 ' Paint color bar
  117.                 tmp = (rc.bottom - rc.top) / 5
  118.                 Call InflateRect(rc, -tmp, -tmp)
  119.                 hBrush = CreateSolidBrush(DrawInfo.itemData)
  120.                 hOldBrush = SelectObject(DrawInfo.hDC, hBrush)
  121.                 tmp = Rectangle(DrawInfo.hDC, rc.left, rc.top, rc.right, rc.bottom)
  122.                 tmp = SelectObject(DrawInfo.hDC, hOldBrush)
  123.                 tmp = DeleteObject(hBrush)
  124.             End If
  125.         Case WM_MEASUREITEM
  126.             ' Copy MEASUREITEMSTRUCT to local variable
  127.             Call hmemcpy(MeasureInfo, ByVal lParam, Len(MeasureInfo))
  128.             ' Tell Windows how big our owner-draw items are
  129.             MeasureInfo.itemWidth = 70
  130.             MeasureInfo.itemHeight = GetSystemMetrics(SM_CYMENU)
  131.             ' Copy MEASUREITEMSTRUCT data back to Windows
  132.             Call hmemcpy(ByVal lParam, MeasureInfo, Len(MeasureInfo))
  133.         Case Else
  134.     End Select
  135. End Sub
  136.